# pacotes utilizados

require(keras)
require(dplyr)
require(magrittr)
require(ggplot2)
require(plotly)
require(glue)
require(tfdeploy)

# carregando workspace

load("text_classification.RData")

Introdução

O exemplo desenvolvido aqui foi extraído desta postagem do TensorFlow for R Blog.

Neste exemplo, trabalharemos com o conjunto de dados do IMDB: um conjunto de 50.000 avaliações altamente polarizadas do Internet Movie Database. Eles são divididos em 25.000 avaliações para treinamento e 25.000 avaliações para testes, cada conjunto consistindo em 50% de avaliações negativas e 50% positivas.

Para análise só foram consideradas as 10000 mais frequentes palavras. O objetivo desta análise é a classificação de um review em positivo ou negativo.

Foi utilizado modelos de Deep Learning para classificação. O modelo utiliza a biblioteca keras, que em seu back-end roda em TensorFlow.

Método

Arquitetura da rede

O modelo utilizado é um Multi-Layer Perceptron como apresentado abaixo:

DiagrammeR::grViz("mlp.gv")

Estrutura da rede

A função de ativação nas camadas ocultas foram a relu e na classificação foi a sigmoid.

relu <- function(x) ifelse(x <= 0, 0, x)

ggplotly(tibble(x = seq(-2, 1.5, .1)) %>% 
           ggplot() +
           aes(x) +
           stat_function(fun = relu, colour = "blue", size = 1.1) +
           labs(x = "", y = "") + 
           theme_minimal(), tooltip = "") %>% 
  config(displayModeBar = FALSE)

Função relu

sigmoid <- function(x) 1/(1 + exp(-x))

ggplotly(tibble(x = seq(-6, 6, .1)) %>% 
           ggplot() +
           aes(x) +
           stat_function(fun = sigmoid, colour = "blue", size = 1.1) +
           labs(x = "", y = "") + 
           theme_minimal(), tooltip = "") %>% 
  config(displayModeBar = FALSE)

Função sigmoid

Função de custo

Pelo fato do output da rede ser uma probabilidade (uma camada simples com função de ativação sigmoid) a função de custo indicada é a entropia cruzada. A entropia cruzada é utilizada como forma de estimar o erro entre a distribuição verdadeira e a prevista, e assim atualizar os pesos das camadas ocultas via backpropagation.

A entropia cruzada é determinada por:

\[-\sum_{c=1}^M y_{o, c}\log(p_{o, c})\]

  • \(M\) é numéro de classes
  • \(y\) é um indicador binário (0 ou 1)
  • \(p\) é a probabilidade predita
  • \(\log\) é a função de logarítimo natural

Outras funções de custo poderão ser vistas aqui.

Construção da base de dados

Leitura da base completa:

# leitura da base completa

imdb <- dataset_imdb(num_words = 10000)

Construção da base de treino e teste. Foram selecionados 15000 tanto do treino quanto do teste.

# treino e teste

# treino

set.seed(5)
train_labels <- 
  tibble(y = imdb$train$y, id = 1:25000) %>% 
  group_by(y) %>% 
  sample_n(size = 7500) %>% 
  ungroup()

train_data <- 
  train_labels %>% 
  pull(id) %>% 
  purrr::map(~ imdb$train$x[[.x]])

# teste

set.seed(7)
test_labels <- 
  tibble(y = imdb$test$y, id = 1:25000) %>% 
  group_by(y) %>% 
  sample_n(size = 7500) %>% 
  ungroup()

test_data <- 
  test_labels %>% 
  pull(id) %>% 
  purrr::map(~ imdb$test$x[[.x]])

Para decodificar um review segue o código e o exemplo abaixo.

Seja o review codificado como:

str(train_data[[1]])
##  int [1:138] 1 14 9 31 7 148 102 198 269 8 ...

A decodificação fica:

# decodificar um review

word_index <- dataset_imdb_word_index()
reverse_word_index <- names(word_index)
names(reverse_word_index) <- word_index

decoded_review <- sapply(train_data[[1]], function(index) {
  word <- if (index >= 3) reverse_word_index[[as.character(index - 3)]]
  if (!is.null(word)) word else "?"
})

cat(decoded_review)
## ? this is one of those movies that's trying to be moody and tense and instead ends up ? all over itself having seen it at a ? film festival i was intrigued by the young college ? gone wrong write up however over all ended up quite disappointed br br it's hard to critique a true story since there's not much that can be done about the plot but i found this disjointed melodramatic and wholly depressing it's dark and almost sinister painting a darn creepy flash of the seventies with ? music and jerky close ups it just doesn't work some scenes where so cheesy that instead of ? awe my audience was ? ? and rolling eyes br br the story has an interesting premise but this just ? ? into a dark miserable spiral

Como mencionado no início somente as 10000 palavras mais frequentes foram consideradas para análise, então quando descodifica, as palavras que não estão entre as principais recebe um “?”.

Preparando os dados

Esta etapa apresenta como os dados devem ser ajustados para poderem ser analisados pela rede.

Função para Tranformando os reviews (inputs) em um vetor de 0s e 1s

vectorize_sequences <- function(sequences, dimension = 10000) {
  # Creates an all-zero matrix of shape (length(sequences), dimension)
  results <- matrix(0, nrow = length(sequences), ncol = dimension) 
  for (i in 1:length(sequences))
    # Sets specific indices of results[i] to 1s
    results[i, sequences[[i]]] <- 1 
  results
}

Adequação dos dados para serem utilizados na rede (tanto do input, quanto do output).

# tranformando os reviews (inputs) em um vetor de 0s e 1s

x_train <- vectorize_sequences(train_data)
x_test <- vectorize_sequences(test_data)

# transformando os outpus em numérico

y_train <- as.numeric(train_labels %>% pull(y))
y_test <- as.numeric(test_labels %>% pull(y))

Construindo a rede

A rede tem 10000 neurônios no input, as funções de ativação relu nas duas camadas escondidas com seus 10 neurônios e uma sigmoid na única camada no output.

model <- keras_model_sequential() %>% 
  layer_dense(units = 10, activation = "relu", input_shape = c(10000)) %>% 
  layer_dense(units = 10, activation = "relu") %>% 
  layer_dense(units = 1, activation = "sigmoid")

Treinamento

Para o treinamento foi utilizada a função de custo de entropia cruzada e como métrica a acurácia.

model %>% compile(
  optimizer = "rmsprop",
  loss = "binary_crossentropy",
  metrics = c("accuracy")
)

model %>% fit(x_train, y_train, epochs = 4, batch_size = 512)
results <- model %>% evaluate(x_test, y_test)

Para salvar o modelo e utilizá-lo em algum deploy por exemplo.

model %>% export_savedmodel("savedmodel")

A acurácia foi de 0.8832.

Predição

Então dado o modelo que foi ajustado, vamos predizer se um review é positivo ou negativo.

The film is: best, great, beautiful and wonderful!

Segue a implementação da função para codificação.

# codificação

coded_review <- function(review){
  
  words <-
    review %>% 
    tolower() %>% 
    strsplit(split = " ") %>% .[[1]] %>% 
    gsub("[!,:]", "", x = .)
  
  index <- names(reverse_word_index[reverse_word_index %in% words]) # ver como preservar a ordem
  
  return(list(as.numeric(index) + 3))
  
}

E o resultado da codificação do exemplo é:

(exemplo1 <- 
  "The film is: best, great, beautiful and wonderful!" %>% 
  coded_review()) %>% str
## List of 1
##  $ : num [1:8] 118 307 9 87 4 5 389 22

O segundo exemplo:

The film is: the worst, bad, defeat and boring!

(exemplo2 <- 
  "The film is: the worst, bad, defeat and boring!" %>%
  coded_review()) %>% str
## List of 1
##  $ : num [1:8] 9 357 4108 78 4 ...

Abaixo a transformação dos reviews codificados no vetor input de dimensão 10000.

# transformando em um vetor de input

(exemplo_vector1 <- vectorize_sequences(exemplo1)) %>% str
##  num [1, 1:10000] 0 0 0 1 1 0 0 0 1 0 ...
(exemplo_vector2 <- vectorize_sequences(exemplo2)) %>% str
##  num [1, 1:10000] 0 0 0 1 1 0 0 0 1 0 ...

A seguir a predição em termos de probabilidade de cada exemplo.

exemplo_vector1 %>% 
  predict_savedmodel("savedmodel")
## $dense_3
## [1] 0.696815
exemplo_vector2 %>% 
  predict_savedmodel("savedmodel")
## $dense_3
## [1] 0.3107629